Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 081 / message.arc / MESSAGE.BAS next >

Wrap

BASIC Source File | 1988-02-20 | 19.1 KB | 708 lines

' Program Name: Message ' ' Version: 8.2 2-20-88 ' ' Another Almost Useful Utility by WalkBro & Kelleher ' Written by: Butch Walker 161/1 ' Version 5.0 ' Additional credits: Mike Kelleher 161/521 ' Version 6.0 ' (quick option) ' ' Mike Bader 120/17 ' Assistance on Version 8.1 ' Debugging and new option requests ' Re-written by: Don Walker 120/20 ' Version 5.1 - 5.3 ' Version 7.0 ' Version 8.0 - ??? ' Changes made 5.1 ' Added loop, dropped excess code ;-) ' Corrected problem with gaps in echo files ' Added a bit of structure ' Added some documentation ' Changes made 5.2 - released as Message7 by Butch Walker 2-14-88 ' Added "A" Option ' Made RA a default choice so that input file is only ' required command line parameter. ' Added more structure ' Started HEX logic for NewOpus ' Continued cleaning-up ' Changes made 5.3 - replaced 5.2 in Message7.Arc 2-16-88 ' Improved Counter(x) logic with direct assignment ' Significant speed improvement! ' More structure, improved logic ' Changes made 8.0 - 2-17-88 ' Merged Mike's code - Q (Quick) option ' Default is A - most common usage ' Goto's are gone from code used!! ' Changes made 8.1 - 2-17-88 ' Changes command line input (a bunch) ' Provides automatic help screen by typing Message ' with no command line parameters ' Adds /c option for callers within last xx days ' Adds /p option to _not_ show priv levels in output ' Adds /o option to denote next parameter is option list ' Adds /f option to denote that next parameter is input file ' Adds /n option to denote that this is a "New Opus" user.bbs file ' OPUS BBS after Version 1.1 uses hex message areas. ' Adds /d option to use defaults of: ' Option list = "A" ' Input file = "Echo.lst" ' Made output prettier ' Changes made 8.2 - 2-20-88 ' Fixed two bugs (gasp) ' Finished help screen (MDW) ' Changes still desired: ' ????????????? ' If you read this and would like to suggest an improvement or useful option ' please contact Don Walker Netmail 120/20 ' ' ----------- CODE STARTS ----------------- ' Default variable type is integer in this module DEFINT A-Z ' Declare the Comline Subprogram, as well as the number and ' type of its parameters DECLARE SUB Comline (N, Q$(), Max) DIM Q$(1 TO 15), AREA$(200), AN$(200), ANAME$(200), A(200), Counter(200), D(180), beg(12), mo$(12) ' set up array for use with the /c option FOR mo = 1 TO 12 READ mo$(mo) NEXT mo DATA Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec ' number of days elapsed prior to beginning of month FOR m = 1 TO 12 READ beg(m) NEXT m DATA 0,31,59,90,120,151,181,212,243,273,304,334 'calculate number of days that have elapsed since 1980 ' this is used in the /c option today$ = DATE$ d1 = VAL(LEFT$(today$, 2)) d2 = VAL(MID$(today$, 4, 2)) d3 = VAL(RIGHT$(today$, 4)) - 1980 today = beg(d1) + d2 + d3 * 365 Start! = TIMER CLS ' print program header PRINT " MESSAGE - ANOTHER ALMOST USEFUL UTILITY" PRINT " Version 8.2" PRINT " Supported by: BUTCH WALKER NERD'S NOOK" PRINT " Matrix 161/1 415-672-2504" PRINT PRINT PRINT " (c) 1988 - WalkBro & Kelleher" PRINT ' Get what was typed on the command line CALL Comline(N, Q$(), 10) ' Q$() is what will get passed back current = 0 days = 0 z$ = "A" Echo$ = "Echo.lst" IF N = 0 THEN ' if the user type message with no command ' line parameters, the program will supply GOSUB help ' a one page help screen. SYSTEM ELSE END IF ' convert command line parameters into ' useful variables and option flags FOR Arg = 1 TO N IF Q$(Arg) = "/C" THEN days = VAL(Q$(Arg + 1)) IF Q$(Arg) = "/P" THEN noprivs = 1 IF Q$(Arg) = "/O" THEN z$ = Q$(Arg + 1) IF Q$(Arg) = "/F" THEN Echo$ = Q$(Arg + 1) IF Q$(Arg) = "/N" THEN NewOpus = 1 IF Q$(Arg) = "/D" THEN z$ = "A" Echo$ = "Echo.lst" ELSE END IF NEXT Arg IF INSTR(z$, "A") THEN ' open input file given on Command line (Echo$) ' each line contains an Area number and the Echo Name OPEN "I", 3, Echo$ x = 1 WHILE NOT EOF(3) ' grab a line LINE INPUT #3, AREA$(x) ' temporary array to hold data x = x + 1 WEND MaxArea = x ' number of lines in the input file FOR x = 1 TO MaxArea AN$(x) = MID$(AREA$(x), 1, 3) ' extract area number A(x) = VAL(AN$(x)) ' convert to # ANAME$(A(x)) = MID$(AREA$(x), 4, 20) ' assign echo name to array NEXT x MaxEcho = A(MaxArea - 1) ' Total number of message areas ' Assumes that highest message area ' is an EchoMail area. ELSE END IF TopReportOne: L$ = "MESSAGE AREA ### ### ### ### ### ### ### ###" L1$ = "MESSAGE ### ### ### ### ### ### ### ###" OPEN "USER.BBS" FOR RANDOM AS #1 LEN = 180 FIELD #1, 180 AS A$ ' each user record is 180 bytes length = 36 ' name filed is 36 bytes ' based upon command line parameters given, branch IF z$ = "A" THEN GOSUB Readers ' We will gather data only (DEFAULT) IF z$ = "R" THEN GOSUB Quick ' Message readers (quick) IF z$ = "RQ" THEN GOSUB Quick ' Message readers (quick) IF z$ = "N" THEN GOSUB Quick ' Non-readers (quick) IF z$ = "NQ" THEN GOSUB Quick ' Non-readers (quick) IF z$ = "RA" THEN GOSUB Quick ' Readers (quick) and summary IF z$ = "RAQ" THEN GOSUB Quick ' Readers (quick) and summary IF z$ = "RAD" THEN GOSUB Readers ' Readers (detail) and summary IF z$ = "NA" THEN GOSUB Quick ' Non-readers (quick) and summary IF z$ = "NAQ" THEN GOSUB Quick ' Non-readers (quick) and summary SYSTEM ' sub-routines start here ----------------- GetName: GET #1 user = user + 1 FOR x = 1 TO length ' create user name IF ASC(MID$(A$, x, 1)) = 0 THEN x = length ' Fido uses CHR$(0) to end a string ELSE b$ = b$ + MID$(A$, x, 1) ' build it up char by char END IF NEXT x RETURN LastCalled: c$ = MID$(A$, 143, 20) ' last time called ' 20 bytes alloted DayMonth = VAL(MID$(c$, 1, 2)) ' day is two leftmost characters Month$ = MID$(c$, 4, 3) ' month is a 3 character string ' starting at position 4. Year = VAL(MID$(c$, 8, 2)) ' year is a 2 character string ' starting at position 8. FOR mo = 1 TO 12 ' find a match for the month$ IF mo$(mo) = Month$ THEN ' to determine the value 1-12 days1 = beg(mo) ELSE END IF NEXT mo DaysSince1980 = DayMonth + days1 + 365 * (Year - 80) DaysSinceCalled = today - DaysSince1980 RETURN Counters: ' key data collection routine FOR x = 72 TO 113 ' Message areas and counters ' are held here. Convert to ' numbers for ease of use. IF NewOpus = 0 THEN ' this flag will have to be set upon ' entry to the program using the ' /n option. (NewOpus = 1) D(x) = ASC(MID$(A$, x, 1)) ELSE ' Newer versions of Opus allow for 256 ' message areas and forces the use of ' HEX values in the systemXX.bbs . Since ' the User.BBS is set-up in decimal format ' we must convert back to something that matches ' the system.bbs D(x) = VAL(HEX$(ASC(MID$(A$, x, 1)))) END IF NEXT x '************* PUT AREA # LOGIC HERE ****************** ' increment counters for each of the message areas if this user ' shows having read them FOR z = 73 TO 101 STEP 4 ' changed for version 5.3 Counter(D(z)) = Counter(D(z)) + 1 NEXT z RETURN ' done with this routine "Counters" Privs: Pr$ = "" ' start with a null string ' test for various priv levels Priv = ASC(MID$(A$, 141, 1)) IF Priv = 0 THEN Pr$ = "Disgrace" IF Priv = 2 THEN Pr$ = "Normal" IF Priv = 4 THEN Pr$ = "Privel" IF Priv = 6 THEN Pr$ = "Extra" IF Priv = 8 THEN Pr$ = "AsstSysop" IF Priv = 10 THEN Pr$ = "Sysop" ' does this cover all the possibilities anymore? IF Pr$ = "" THEN Pr$ = "Twit" ' if he ain't one of the above ' then he's gotta be a twit! RETURN Readers: IF z$ <> "A" THEN PRINT PRINT "Users taking advantage of Message Areas" PRINT ELSE END IF WHILE NOT EOF(1) b$ = "": c$ = "" GOSUB GetName ' get user name GOSUB LastCalled ' get last time called IF days = 0 OR days >= DaysSinceCalled THEN ' check if user is current GOSUB Counters ' /c option ' get last message read in up to eight areas ' IF z$ <> "A" THEN ' we don't need to do the rest of the stuff! Pr$ = " " IF noprivs = 0 THEN GOSUB Privs ' get this guys priviledge level ' add all of the message areas together ' if the sum is greater than one, this guy reads some messages IF D(75) + D(79) + D(83) + D(87) + D(91) + D(95) + D(99) + D(103) > 0 THEN IF z$ <> "A" THEN GOSUB PrintUser ' this user read messages print him user1 = user1 + 1 ELSE END IF ELSE END IF WEND ' keep going until all user records have been read ' we finished the first part so it's time to see ' if the summary is required. GOSUB BottomReport ' If we make it here it is time to end the program TheEnd! = TIMER PRINT ' used for timing this sucker to see if better code is quicker! 'PRINT " This run took "; TheEnd! - Start!; " seconds" RETURN Quick: ' starts the section for those not reading the message areas ' "Who are those turkeys anyway?" "Why do I pay $1000 per month to bring ' the best of EchoMail to their doorstep?" IF INSTR(z$, "N") THEN PRINT PRINT " Users NOT taking advantage of Message Areas"; IF days > 0 THEN PRINT " during the last "; days; " days." ELSE PRINT END IF PRINT ELSE END IF IF INSTR(z$, "R") THEN PRINT PRINT " Users taking advantage of Message Areas"; IF days > 0 THEN PRINT " during the last "; days; " days." ELSE PRINT END IF PRINT PRINT " User Last Called Priv " PRINT "-------------------- ----------------- ------" PRINT ELSE END IF WHILE NOT EOF(1) b$ = "": c$ = "" GOSUB GetName GOSUB LastCalled IF days = 0 OR days >= DaysSinceCalled THEN ' check if user is current GOSUB Counters ' /c option Pr$ = " " IF noprivs = 0 THEN GOSUB Privs GOSUB ShowArea ' check areas read and determine whether to print ELSE END IF WEND ' time to see if the summary report is wanted IF INSTR(z$, "A") THEN GOSUB BottomReport RETURN BottomReport: PRINT CHR$(12) ' start with a fresh page by print a page break PRINT ' two fresh lines at the top PRINT ' not-so-sexy header PRINT " Number of Users reading Local and Echomail Areas" IF days > 0 THEN PRINT " during the last "; days; " days." PRINT PRINT " Total Number of Users "; user PRINT " Total Number of Users Surveyed "; user1 PRINT PRINT " Area Number Area Name Number of Users" L10$ = " ### \ \ ###" ' if ANAME$(x) is null, then this area is a LOCAL message base. ' of course, the user of this program may not have an accurate input file! ' lets print the report (even if longer than one page) FOR x = 1 TO MaxEcho ' MaxEcho is assumed to be the highest message area IF ANAME$(x) = "" THEN ANAME$(x) = "(Local)" PRINT USING L10$; x, ANAME$(x), Counter(x) NEXT PRINT PRINT FOR x = 1 TO 200 TotalRead = TotalRead + Counter(x) ' get a grand total of our NEXT x ' success experiences. PRINT "Total Area Activity Count ="; TotalRead PRINT PRINT "Average Areas read per user surveyed ="; PRINT USING " #.##"; TotalRead / user1 RETURN ' we are done with this program PrintUser: PRINT USING "USER: & & &"; b$, c$, Pr$ ' message area PRINT USING L$; D(73), D(77), D(81), D(85), D(89), D(93), D(97), D(101) ' last message read counter PRINT USING L1$; D(75), D(79), D(83), D(87), D(91), D(95), D(99), D(103) PRINT RETURN ' THIS STARTS MIKE'S CODE PAUSEKEY: IF (Q$ = "p") OR (Q$ = "P") THEN GOSUB HOLD001: RETURN IF (Q$ = "q") OR (Q$ = "Q") THEN CLOSE : PRINT : PRINT "Aborted by operator.": END RETURN HOLD001: PRINT "Display paused by operator..."; HOLDKEY: Q$ = INKEY$: IF Q$ = "" THEN GOTO HOLDKEY PRINT RETURN ShowArea: trycount = 0 ' how many areas has he read? FOR c = 75 TO 103 STEP 4 IF D(c) <> 0 THEN trycount = trycount + 1 NEXT c IF trycount = 0 AND INSTR(z$, "N") THEN ' if he is a non-reader and ' we have chosen the "N" option ' this is the place to be. tt$ = STR$(trycount) 'trycount$ = LEFT$(tt$, LEN(tt$) - 1) trycount$ = RIGHT$(tt$, LEN(tt$) - 1) ShowUser: PRINT b$; TAB(25); c$; " "; Pr$; " "; PRINT TAB(60); PRINT " Visited "; trycount$; IF trycount = 8 THEN PRINT "+"; IF trycount = 8 THEN PRINT " areas." ELSE PRINT " areas." user1 = user1 + 1 ELSEIF trycount > 0 AND INSTR(z$, "R") THEN ' if he is a reader and we ' have chosen the "R" option ' this is the place to be. tt$ = STR$(trycount) 'trycount$ = LEFT$(tt$, LEN(tt$) - 1) trycount$ = RIGHT$(tt$, LEN(tt$) - 1) ShowUser1: PRINT b$; TAB(25); c$; " "; Pr$; " "; PRINT TAB(60); PRINT " Visited "; trycount$; IF trycount = 8 THEN PRINT "+"; IF trycount = 8 THEN PRINT " areas." ELSE PRINT " areas." user1 = user1 + 1 ELSE END IF RETURN 'this ends mike's code help: CLS (0) PRINT "A message area usage checking utility from WalkBro & Kelleher." PRINT PRINT "Options-" PRINT PRINT "/c ## - number of days since last call" PRINT "/p - don't print Privs" PRINT "/o {options} - desired output option" PRINT "/f {filename} - input filename of area list" PRINT "/n - NewOpus 1.10 (hex area numbers)" PRINT "/d - use defaults (A output and Echo.lst for filename)" PRINT PRINT "Output options- /o {options}" PRINT PRINT "R - List message readers N - List Non Readers" PRINT "A - Just the area Use" PRINT "RA- List readers plus area use" PRINT "NA- List non readers plus area use" PRINT "RAD- List Readers with Detail and area use." PRINT PRINT "Sample command line -" PRINT "Message /c 30 /p /o RAD -f echo.lst > prn" RETURN ' Subroutine to get command line and split into arguments ' Parameters : NumArgs : Number of command line args found ' Args$() : Array in which to return arguments ' MaxArgs : Maximum number of arguments array can ' return. SUB Comline (NumArgs, Args$(), MaxArgs) STATIC CONST TRUE = -1, FALSE = 0 NumArgs = 0: In = FALSE ' Get the command line using the COMMAND$ function C1$ = UCASE$(COMMAND$) L = LEN(C1$) ' Go through the command line a character at a time. FOR I = 1 TO L c$ = MID$(C1$, I, 1) ' Test for character being blank or space. IF (c$ <> " " AND c$ <> CHR$(9)) THEN 'Neither blank nor tab. 'Test to see if you're already inside an argument IF NOT In THEN 'You've found the start of a new argument. 'Test for too many arguments IF NumArgs = MaxArgs THEN EXIT FOR NumArgs = NumArgs + 1 In = TRUE END IF 'Add the character to the current argument Args$(NumArgs) = Args$(NumArgs) + c$ ELSE 'Found a blank or Tab 'Set "Not in an argument" flag to FALSE. In = FALSE END IF NEXT I END SUB